home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_gettext.idb / usr / freeware / share / emacs / site-lisp / po-mode.el.z / po-mode.el
Encoding:
Text File  |  1999-04-16  |  43.0 KB  |  1,273 lines
  1. ;;; po-mode.el -- for helping GNU gettext lovers to edit PO files.
  2. ;;; Copyright (C) 1995 Free Software Foundation, Inc.
  3. ;;; Franτois Pinard <pinard@iro.umontreal.ca>, 1995.
  4. ;;; Helped by Greg McGary <gkm@magilla.cichlid.com>.
  5.  
  6. ;; This file is part of GNU gettext.
  7.  
  8. ;; GNU gettext is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; GNU gettext is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20. ;; Free Software Foundation, 59 Temple Place - Suite 330, Boston,
  21. ;; MA 02111-1307, USA.
  22.  
  23. ;;; This package provides the tools meant to help editing PO files,
  24. ;;; as documented in the GNU gettext user's manual.  See this manual
  25. ;;; for user documentation, which is not repeated here.
  26.  
  27. ;;; To install, merely put this file somewhere GNU Emacs will find it,
  28. ;;; then add the following lines to your .emacs file:
  29. ;;;
  30. ;;;   (setq auto-mode-alist
  31. ;;;         (cons (cons "\\.pox?\\'" 'po-mode) auto-mode-alist))
  32. ;;;   (autoload 'po-mode "po-mode")
  33.  
  34.  
  35. (defun po-mode-version ()
  36.   "Show Emacs PO mode version."
  37.   (interactive)
  38.   (message "Emacs PO mode, version %s" (substring "$Revision: 1.18 $" 11 -2)))
  39.  
  40.  
  41. (defvar po-help-display-string
  42.   "           Summary of PO mode Commands    (* means yet to come)
  43.  
  44. Any Type of Entry        Obsolete Entries            Untranslated Entries
  45. n, SPC   Find next       M-n, M-SPC  Find next       e    Find next
  46. p, DEL   Find previous   M-p, M-DEL  Find previous   M-e  Find previous
  47. .        Redisplay                                   TAB  Init from msgid
  48. <        First       q     quit           u  undo
  49. >        Last        o     other window   =  position   *s    To compendium
  50. z        Fade out    h, ?  help           v  validate   *M-s  Select, save
  51.                      V     version info
  52. Inexact entries
  53. I     Find next       Translations           Translator Comments
  54. M-I   Find previous   RET   Call editor      M-RET, #  Call editor
  55. ???   Remove warning  k     Kill to ring     M-k       Kill to ring
  56.                       w     Copy to ring     M-w       Copy to ring
  57.   Position Stack      y     Yank from ring   M-y       Yank from ring
  58.   m  Push current
  59.   l  Pop and return            Program Sources         Auxiliary Files
  60.   x  Exchange top           c    Cycle reference    *a    Cycle file
  61.                             M-c  Select reference   *M-a  Select file
  62.   gettext Keyword Marking   d    Add to path        *f    Add file
  63.   ,    Find next string     M-d  Delete from path   *M-f  Delete file
  64.   M-,  Mark translatable
  65.   M-.  Change mark, mark
  66. ")
  67.  
  68. (defvar po-any-msgid-regexp
  69.   "^\\(#[ \t]*\\)?msgid.*\n\\(\\(#[ \t]*\\)?\".*\n\\)*"
  70.   "Regexp matching a whole msgid field, whether obsolete or not.")
  71.  
  72. (defvar po-any-msgstr-regexp
  73.   "^\\(#[ \t]*\\)?msgstr.*\n\\(\\(#[ \t]*\\)?\".*\n\\)*"
  74.   "Regexp matching a whole msgstr field, whether obsolete or not.")
  75.  
  76. (defvar po-msgfmt-program "msgfmt"
  77.   "Path to msgfmt program from GNU gettext package.")
  78.  
  79. ;; Highlight PO files if hilit19.elc has been loaded first.
  80. (if (fboundp 'hilit-set-mode-patterns)
  81.     (hilit-set-mode-patterns 'po-mode
  82.                  '(("^#.*$" nil comment)
  83.                    ;; Hilighting strings is overkill, don't do it.
  84.                    ;; (hilit-string-find ?\\ string)
  85.                    ("^\\(msgid\\|msgstr\\)\\>" nil keyword))))
  86.  
  87. ;; Highlight PO files if font-lock.elc has been loaded first.
  88. (defconst po-font-lock-keywords (purecopy
  89.   (list
  90.    '("^#.*$" . font-lock-comment-face)
  91.    '("^#:\\(.*\\)\\>" 1 font-lock-function-name-face t)
  92.    '("^\\(msgid\\|msgstr\\)\\>" . font-lock-keyword-face)
  93.   ))
  94.   "Additional expressions to highlight in po-mode.")
  95. (if (boundp 'font-lock-keywords)
  96.     (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords))
  97.  
  98. ;;; Mode activation.
  99.  
  100. (defvar po-mode-map nil
  101.   "Keymap for PO mode.")
  102. (if po-mode-map
  103.     ()
  104.   ;; The following line because (make-sparse-keymap) does not work on Demacs.
  105.   (setq po-mode-map (make-keymap))
  106.   (suppress-keymap po-mode-map)
  107.   (define-key po-mode-map "\C-i" 'po-msgid-to-msgstr)
  108.   (define-key po-mode-map "\C-m" 'po-edit-msgstr)
  109.   (define-key po-mode-map " " 'po-next-entry)
  110.   (define-key po-mode-map "?" 'po-help)
  111.   (define-key po-mode-map "#" 'po-edit-comment)
  112.   (define-key po-mode-map "," 'po-tags-search)
  113.   (define-key po-mode-map "." 'po-current-entry)
  114.   (define-key po-mode-map "<" 'po-first-entry)
  115.   (define-key po-mode-map "=" 'po-statistics)
  116.   (define-key po-mode-map ">" 'po-last-entry)
  117. ;;;;  (define-key po-mode-map "a" 'po-cycle-auxiliary)
  118.   (define-key po-mode-map "c" 'po-cycle-reference)
  119.   (define-key po-mode-map "d" 'po-add-path)
  120.   (define-key po-mode-map "e" 'po-next-untranslated-entry)
  121. ;;;;  (define-key po-mode-map "f" 'po-add-auxiliary)
  122.   (define-key po-mode-map "h" 'po-help)
  123.   (define-key po-mode-map "i" 'po-next-inexact)
  124.   (define-key po-mode-map "k" 'po-kill-msgstr)
  125.   (define-key po-mode-map "l" 'po-pop-location)
  126.   (define-key po-mode-map "m" 'po-push-location)
  127.   (define-key po-mode-map "n" 'po-next-entry)
  128.   (define-key po-mode-map "p" 'po-previous-entry)
  129.   (define-key po-mode-map "o" 'po-other-window)
  130.   (define-key po-mode-map "q" 'po-quit)
  131. ;;;;  (define-key po-mode-map "s" 'po-save-entry)
  132.   (define-key po-mode-map "u" 'po-undo)
  133.   (define-key po-mode-map "v" 'po-validate)
  134.   (define-key po-mode-map "V" 'po-mode-version)
  135.   (define-key po-mode-map "w" 'po-kill-ring-save-msgstr)
  136.   (define-key po-mode-map "y" 'po-yank-msgstr)
  137.   (define-key po-mode-map "x" 'po-exchange-location)
  138.   (define-key po-mode-map "z" 'po-fade-out-entry)
  139.   (define-key po-mode-map "\177" 'po-previous-entry)
  140.   (define-key po-mode-map "\M-\C-m" 'po-edit-comment)
  141.   (define-key po-mode-map "\M- " 'po-next-obsolete-entry)
  142.   (define-key po-mode-map "\M-," 'po-mark-translatable)
  143.   (define-key po-mode-map "\M-." 'po-select-mark-and-mark)
  144. ;;;;  (define-key po-mode-map "\M-a" 'po-select-auxiliary)
  145.   (define-key po-mode-map "\M-c" 'po-select-reference)
  146.   (define-key po-mode-map "\M-d" 'po-delete-path)
  147.   (define-key po-mode-map "\M-e" 'po-previous-untranslated-entry)
  148. ;;;;  (define-key po-mode-map "\M-f" 'po-delete-auxiliary)
  149.   (define-key po-mode-map "\M-i" 'po-previous-inexact)
  150.   (define-key po-mode-map "\M-k" 'po-kill-comment)
  151.   (define-key po-mode-map "\M-n" 'po-next-obsolete-entry)
  152.   (define-key po-mode-map "\M-p" 'po-previous-obsolete-entry)
  153. ;;;;  (define-key po-mode-map "\M-s" 'po-select-and-save-entry)
  154.   (define-key po-mode-map "\M-w" 'po-kill-ring-save-comment)
  155.   (define-key po-mode-map "\M-y" 'po-yank-comment)
  156.   (define-key po-mode-map "\M-\177" 'po-previous-obsolete-entry))
  157.  
  158. (defvar po-edit-mode-map nil
  159.   "Keymap while editing a PO mode entry.")
  160. (if po-edit-mode-map
  161.     ()
  162.   (setq po-edit-mode-map (make-sparse-keymap))
  163.   (define-key po-edit-mode-map "\C-c\C-c" 'exit-recursive-edit))
  164.  
  165. (defun po-mode ()
  166.   "Major mode for translators when they edit PO files.
  167. Special commands:\\{po-mode-map}
  168. Turning on PO mode calls the value of the variable `po-mode-hooks',
  169. if that value is non-nil."
  170.   (interactive)
  171.   (kill-all-local-variables)
  172.   (setq major-mode 'po-mode)
  173.   (setq mode-name "PO")
  174.   (use-local-map po-mode-map)
  175.   (setq buffer-read-only t)
  176.  
  177.   ;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY,
  178.   ;; and the line containing the msgstr keyword line starts at
  179.   ;; MIDDLE-OF-ENTRY.  OBSOLETE-FLAG is t for all commented entries.
  180.   (make-local-variable 'po-start-of-entry)
  181.   (make-local-variable 'po-middle-of-entry)
  182.   (make-local-variable 'po-end-of-entry)
  183.   (make-local-variable 'po-obsolete-flag)
  184.  
  185.   ;; A WORK-BUFFER is associated with this PO file, for edition
  186.   ;; and other various tasks.  WORK-BUFFER-LOCK indicates that
  187.   ;; the work buffer is already in use, most probably editing some
  188.   ;; string through Emacs recursive edit.  In this case, one cannot
  189.   ;; modify the buffer.
  190.   (make-local-variable 'po-work-buffer)
  191.   (make-local-variable 'po-work-buffer-lock)
  192.   (setq po-work-buffer
  193.     (generate-new-buffer (concat "*Edit " (buffer-name nil) "*")))
  194.   (setq po-work-buffer-lock nil)
  195.  
  196.   ;; We maintain a set of movable pointers for returning to entries.
  197.   (make-local-variable 'po-marker-stack)
  198.   (setq po-marker-stack nil)
  199.  
  200.   ;; SEARCH path contains a list of directories where files may be
  201.   ;; found, in a format suitable for read completion.   Each directory
  202.   ;; includes its trailing slash.  PO mode starts with "./" and "../".
  203.   (make-local-variable 'po-search-path)
  204.   (setq po-search-path '(("./") ("../")))
  205.  
  206.   ;; The following variables are meaningful only when REFERENCE-CHECK
  207.   ;; is identical to START-OF-ENTRY, else they should be recomputed.
  208.   ;; REFERENCE-ALIST contains all known references for the current entry,
  209.   ;; each list element is (PROMPT FILE LINE), where PROMPT may be
  210.   ;; used for completing read, FILE is a string and LINE is a number.
  211.   ;; REFERENCE-CURSOR is a cycling cursor into REFERENCE-ALIST.
  212.   (make-local-variable 'po-reference-alist)
  213.   (make-local-variable 'po-reference-cursor)
  214.   (make-local-variable 'po-reference-check)
  215.   (setq po-reference-alist nil)
  216.   (setq po-reference-cursor nil)
  217.   (setq po-reference-check 0)
  218.  
  219.   ;; The following variables are for marking translatable strings in
  220.   ;; program sources.  NEXT-FILE-LIST is the list of source files
  221.   ;; to visit, gotten from the tags table.  STRING-START is the
  222.   ;; position for the beginning of the last found string, or nil
  223.   ;; if the string is invalidated.  STRING-END is the position for
  224.   ;; the end of the string and indicates where the search should
  225.   ;; be resumed, or nil for the beginning of the current file.
  226.   ;; KEYWORDS is the list of keywords for marking translatable
  227.   ;; strings, kept in a format suitable for reading with completion.
  228.   (make-local-variable 'po-next-file-list)
  229.   (make-local-variable 'po-string-start)
  230.   (make-local-variable 'po-string-end)
  231.   (make-local-variable 'po-keywords)
  232.   (setq po-next-file-list nil)
  233.   (setq po-string-start nil)
  234.   (setq po-string-end nil)
  235.   (setq po-keywords '(("gettext") ("_")))
  236.  
  237.   ;; OFFER-VALIDATION is set to t when buffer is modified, and reset
  238.   ;; to nil by validation.  At quit time, validation may be offered.
  239.   (make-local-variable 'po-offer-validation)
  240.   (setq po-offer-validation nil)
  241.  
  242.   ;; When this file was generated using msgmerge it might contain
  243.   ;; translations which did not match exactly.  This should be known
  244.   ;; to the user.
  245.   (if (re-search-forward "^#! INEXACT" nil t)
  246.       (error "The file contains INEXACT warnings!"))
  247.  
  248.   (run-hooks 'po-mode-hooks))
  249.  
  250. ;;; Window management.
  251.  
  252. (defun po-redisplay ()
  253.   "Redisplay the current entry."
  254.   (goto-char po-middle-of-entry))
  255.  
  256. (defun po-other-window ()
  257.   "Get the cursor into another window, out of PO mode."
  258.   (interactive)
  259.   (if (one-window-p t)
  260.       (progn
  261.     (split-window)
  262.     (switch-to-buffer (other-buffer)))
  263.     (other-window 1)))
  264.  
  265. (defun po-check-lock ()
  266.   "Ensure that GNU Emacs is not currently in recursive edit for PO mode."
  267.   (if po-work-buffer-lock
  268.       (progn
  269.     (pop-to-buffer po-work-buffer)
  270.     (if (y-or-n-p "Here is your current edit.  Do you wish to abort it? ")
  271.         (abort-recursive-edit)
  272.       (error "Type `C-c C-c' once done")))))
  273.  
  274. ;;; Identifying the span of an entry.
  275.  
  276. (defun po-find-span-of-entry ()
  277.   "Find the extent of the PO file entry where the cursor is.
  278. Set variables PO-START-OF-ENTRY, PO-MIDDLE-OF-ENTRY, PO-END-OF-ENTRY
  279. and PO-OBSOLETE-FLAG to meaningful values."
  280.   (let ((here (point)))
  281.     (if (re-search-backward po-any-msgstr-regexp nil t)
  282.     (progn
  283.  
  284.       ;; After a backward match, under Emacs 19.22 at least,
  285.       ;; (match-end 0) will not extend beyond point, in case
  286.       ;; point was *inside* the regexp.  We need a dependable
  287.       ;; (match-end 0), so we redo the match in the forward
  288.       ;; direction and use (point) instead.
  289.  
  290.       (re-search-forward po-any-msgstr-regexp)
  291.       (if (<= (point) here)
  292.  
  293.           ;; The cursor was before msgstr of its own entry,
  294.           ;; so we just found the msgstr of the previous entry.
  295.           (progn
  296.         (setq po-start-of-entry (point))
  297.         (if (re-search-forward po-any-msgstr-regexp nil t)
  298.             (progn
  299.               (setq po-middle-of-entry (match-beginning 0))
  300.               (setq po-end-of-entry (match-end 0)))
  301.  
  302.           ;; There is no msgstr to this entry, so we ought to
  303.           ;; be in the crumb after the last entry in the file.
  304.           (error "After last entry")))
  305.  
  306.         ;; The cursor was inside msgstr of the current entry.
  307.         (setq po-middle-of-entry (match-beginning 0))
  308.         (setq po-end-of-entry (match-end 0))
  309.         (goto-char (match-beginning 0))
  310.         (if (re-search-backward po-any-msgstr-regexp nil t)
  311.  
  312.         ;; This is not the first entry in the file.
  313.         (progn
  314.           (goto-char (match-end 0))
  315.           (setq po-start-of-entry (point)))
  316.  
  317.           ;; This is the first entry in the file.
  318.           (setq po-start-of-entry (point-min)))))
  319.  
  320.       ;; The cursor was before msgstr in the first entry in the file.
  321.       (goto-char (point-min))
  322.       (setq po-start-of-entry (point))
  323.       (if (re-search-forward po-any-msgstr-regexp nil t)
  324.       (progn
  325.         (setq po-middle-of-entry (match-beginning 0))
  326.         (setq po-end-of-entry (match-end 0)))
  327.  
  328.     ;; In fact, there is absolutely no entry in the file.
  329.     (goto-char here)
  330.     (error "No entries")))
  331.     (goto-char here))
  332.   (setq po-obsolete-flag (eq (char-after po-middle-of-entry) ?#)))
  333.  
  334. ;;; Entry positionning.
  335.  
  336. (defun po-say-location-depth ()
  337.   "Tell how many entries in the entry location stack."
  338.   (let ((depth (length po-marker-stack)))
  339.     (cond ((= depth 0) (message "The location stack is now empty"))
  340.       ((= depth 1) (message "The location stack has one entry"))
  341.       (t (message "The location stack contains %d entries" depth)))))
  342.  
  343. (defun po-push-location ()
  344.   "Stack the location of the current entry, for later return."
  345.   (interactive)
  346.   (po-find-span-of-entry)
  347.   (save-excursion
  348.     (goto-char po-middle-of-entry)
  349.     (setq po-marker-stack (cons (point-marker) po-marker-stack)))
  350.   (po-say-location-depth))
  351.  
  352. (defun po-pop-location ()
  353.   "Unstack a saved location, and return to the corresponding entry."
  354.   (interactive)
  355.   (if po-marker-stack
  356.       (progn
  357.     (goto-char (car po-marker-stack))
  358.     (setq po-marker-stack (cdr po-marker-stack))
  359.     (po-current-entry)
  360.     (po-say-location-depth))
  361.     (error "The entry location stack is empty")))
  362.  
  363. (defun po-exchange-location ()
  364.   "Exchange the location of the current entry with the top of stack."
  365.   (interactive)
  366.   (if po-marker-stack
  367.       (progn
  368.     (po-find-span-of-entry)
  369.     (goto-char po-middle-of-entry)
  370.     (let ((location (point-marker)))
  371.       (goto-char (car po-marker-stack))
  372.       (setq po-marker-stack (cons location (cdr po-marker-stack))))
  373.     (po-current-entry)
  374.     (po-say-location-depth))
  375.     (error "The entry location stack is empty")))
  376.  
  377. (defun po-current-entry ()
  378.   "Display the current entry."
  379.   (interactive)
  380.   (po-find-span-of-entry)
  381.   (po-redisplay))
  382.  
  383. (defun po-first-entry-with-regexp (regexp)
  384.   "Display the first entry in the file which msgstr matches REGEXP."
  385.   (let ((here (point)))
  386.     (goto-char (point-min))
  387.     (if (re-search-forward regexp nil t)
  388.     (progn
  389.       (goto-char (match-beginning 0))
  390.       (po-current-entry))
  391.       (goto-char here)
  392.       (error "There is no such entry"))))
  393.  
  394. (defun po-last-entry-with-regexp (regexp)
  395.   "Display the last entry in the file which msgstr matches REGEXP."
  396.   (let ((here (point)))
  397.     (goto-char (point-max))
  398.     (if (re-search-backward regexp nil t)
  399.     (po-current-entry)
  400.       (goto-char here)
  401.       (error "There is no such entry"))))
  402.  
  403. (defun po-next-entry-with-regexp (regexp wrap)
  404.   "Display the entry following the current entry which msgstr matches REGEXP.
  405. If WRAP is not nil, the search may wrap around the buffer."
  406.   (po-find-span-of-entry)
  407.   (let ((here (point)))
  408.     (goto-char po-end-of-entry)
  409.     (if (re-search-forward regexp nil t)
  410.     (progn
  411.       (goto-char (match-beginning 0))
  412.       (po-current-entry))
  413.       (if (and wrap
  414.            (progn
  415.          (goto-char (point-min))
  416.          (re-search-forward regexp po-start-of-entry t)))
  417.       (progn
  418.         (goto-char (match-beginning 0))
  419.         (po-current-entry)
  420.         (message "Wrapping around the buffer"))
  421.     (goto-char here)
  422.     (error "There is no such entry")))))
  423.  
  424. (defun po-previous-entry-with-regexp (regexp wrap)
  425.   "Redisplay the entry preceding the current entry which msgstr matches REGEXP.
  426. If WRAP is not nil, the search may wrap around the buffer."
  427.   (po-find-span-of-entry)
  428.   (let ((here (point)))
  429.     (goto-char po-start-of-entry)
  430.     (if (re-search-backward regexp nil t)
  431.     (po-current-entry)
  432.       (if (and wrap
  433.            (progn
  434.          (goto-char (point-max))
  435.          (re-search-backward regexp po-end-of-entry t)))
  436.       (progn
  437.         (po-current-entry)
  438.         (message "Wrapping around the buffer"))
  439.     (goto-char here)
  440.     (error "There is no such entry")))))
  441.  
  442. ;; Any entries.
  443.  
  444. (defun po-first-entry ()
  445.   "Display the first entry."
  446.   (interactive)
  447.   (po-first-entry-with-regexp po-any-msgstr-regexp))
  448.  
  449. (defun po-last-entry ()
  450.   "Display the last entry."
  451.   (interactive)
  452.   (po-last-entry-with-regexp po-any-msgstr-regexp))
  453.  
  454. (defun po-next-entry ()
  455.   "Display the entry following the current entry."
  456.   (interactive)
  457.   (po-next-entry-with-regexp po-any-msgstr-regexp nil))
  458.  
  459. (defun po-previous-entry ()
  460.   "Display the entry preceding the current entry."
  461.   (interactive)
  462.   (po-previous-entry-with-regexp po-any-msgstr-regexp nil))
  463.  
  464. ;; Untranslated entries.
  465.  
  466. (defvar po-after-entry-regexp
  467.   "\\(\\'\\|\\(#[ \t]*\\)?[^\"]\\)"
  468.   "Regexp which should be true after a full msgstr string matched.")
  469.  
  470. (defvar po-empty-msgstr-regexp
  471.   (concat "^msgstr[ \t]*\"\"\n" po-after-entry-regexp)
  472.   "Regexp matching a whole msgstr field, but only if active and empty.")
  473.  
  474. (defun po-next-untranslated-entry ()
  475.   "Find the next untranslated entry, wrapping around if necessary."
  476.   (interactive)
  477.   (po-next-entry-with-regexp po-empty-msgstr-regexp t))
  478.  
  479. (defun po-previous-untranslated-entry ()
  480.   "Find the previous untranslated entry, wrapping around if necessary."
  481.   (interactive)
  482.   (po-previous-entry-with-regexp po-empty-msgstr-regexp t))
  483.  
  484. ;; Obsolete entries.
  485.  
  486. (defvar po-obsolete-msgstr-regexp
  487.   "^#[ \t]*msgstr.*\n\\(#[ \t]*\".*\n\\)*"
  488.   "Regexp matching a whole msgstr field of an obsolete entry.")
  489.  
  490. (defun po-next-obsolete-entry ()
  491.   "Find the next obsolete entry, wrapping around if necessary."
  492.   (interactive)
  493.   (po-next-entry-with-regexp po-obsolete-msgstr-regexp t))
  494.  
  495. (defun po-previous-obsolete-entry ()
  496.   "Find the previous obsolete entry, wrapping around if necessary."
  497.   (interactive)
  498.   (po-previous-entry-with-regexp po-obsolete-msgstr-regexp t))
  499.  
  500. ;; Inexact translations.
  501.  
  502. (defvar po-inexact-regexp
  503.   "^#! INEXACT"
  504.   "Regexp matching the string inserted by msgmerge for translations
  505. which does not match exactly.")
  506.  
  507. (defun po-next-inexact ()
  508.   "Find the next inexact entry, wrapping around if necessary."
  509.   (interactive)
  510.   (po-next-entry-with-regexp po-inexact-regexp t))
  511.  
  512. (defun po-previous-inexact ()
  513.   "Find the next inexact entry, wrapping around if necessary."
  514.   (interactive)
  515.   (po-previous-entry-with-regexp po-inexact-regexp t))
  516.  
  517. ;;; Killing and yanking fields.
  518.  
  519. (if (fboundp 'kill-new)
  520.  
  521.     (fset 'po-kill-new (symbol-function 'kill-new))
  522.  
  523.   (defun po-kill-new (string)
  524.     "Push STRING onto the kill ring, for Emacs 18 where kill-new is missing."
  525.     (po-check-lock)
  526.     (save-excursion
  527.       (set-buffer po-work-buffer)
  528.       (erase-buffer)
  529.       (insert string)
  530.       (kill-region (point-min) (point-max)))))
  531.  
  532. (defun po-extract-unquoted (buffer start end)
  533.   "Extract and return the unquoted string in BUFFER going from START to END.
  534. Crumb preceding or following the quoted string is ignored."
  535.   (po-check-lock)
  536.   (save-excursion
  537.     (set-buffer po-work-buffer)
  538.     (erase-buffer)
  539.     (insert-buffer-substring buffer start end)
  540.     (goto-char (point-min))
  541.     (search-forward "\"")
  542.     (delete-region (point-min) (point))
  543.     (goto-char (point-max))
  544.     (search-backward "\"")
  545.     (delete-region (point) (point-max))
  546.     (goto-char (point-min))
  547.     (while (re-search-forward "\"[ \t]*\\\\?\n#?[ \t]*\"" nil t)
  548.       (replace-match "" t t))
  549.     (goto-char (point-min))
  550.     (while (re-search-forward "\\\\[\\\"abfnt\\\\]" nil t)
  551.       (cond ((eq (preceding-char) ?\") (replace-match "\"" t t))
  552.         ((eq (preceding-char) ?a) (replace-match "\a" t t))
  553.         ((eq (preceding-char) ?b) (replace-match "\b" t t))
  554.         ((eq (preceding-char) ?f) (replace-match "\f" t t))
  555.         ((eq (preceding-char) ?n) (replace-match "\n" t t))
  556.         ((eq (preceding-char) ?t) (replace-match "\t" t t))
  557.         ((eq (preceding-char) ?\\) (replace-match "\\" t t))))
  558.     (buffer-string)))
  559.  
  560. (defun po-eval-requoted (form prefix obsolete)
  561.   "Eval FORM, which inserts a string, and return the string fully requoted.
  562. If PREFIX, precede the result with its contents.  If OBSOLETE, comment all
  563. generated lines in the returned string.  Evaluating FORM should insert the
  564. wanted string in the buffer which is current at the time of evaluation.
  565. If FORM is itself a string, then this string is used for insertion."
  566.   (po-check-lock)
  567.   (save-excursion
  568.     (set-buffer po-work-buffer)
  569.     (erase-buffer)
  570.     (if (stringp form)
  571.     (insert form)
  572.       (push-mark)
  573.       (eval form))
  574.     (goto-char (point-min))
  575.     (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t)))
  576.       (goto-char (point-min))
  577.       (while (re-search-forward "[\\\"\a\b\f\n\t\\\\]" nil t)
  578.     (cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t))
  579.           ((eq (preceding-char) ?\a) (replace-match "\\a" t t))
  580.           ((eq (preceding-char) ?\b) (replace-match "\\b" t t))
  581.           ((eq (preceding-char) ?\f) (replace-match "\\f" t t))
  582.           ((eq (preceding-char) ?\n)
  583.            (replace-match (if (or (not multi-line) (eobp))
  584.                   "\\n"
  585.                 "\\n\"\n\"")
  586.                   t t))
  587.           ((eq (preceding-char) ?\t) (replace-match "\\t" t t))
  588.           ((eq (preceding-char) ?\\) (replace-match "\\\\" t t))))
  589.       (goto-char (point-min))
  590.       (if prefix (insert prefix " "))
  591.       (insert (if multi-line "\"\"\n\"" "\""))
  592.       (goto-char (point-max))
  593.       (insert "\"")
  594.       (if prefix (insert "\n"))
  595.       (if obsolete
  596.       (progn
  597.         (goto-char (point-min))
  598.         (insert "# ")
  599.         (while (and (search-forward "\n" nil t) (not (eobp)))
  600.           (insert "# "))))
  601.       (buffer-string))))
  602.  
  603. (defun po-get-field (msgid kill)
  604.   "Extract and return the unquoted msgstr string, unless MSGID selects msgid.
  605. If KILL, then add the unquoted string to the kill ring."
  606.   (let ((string (if msgid
  607.             (progn
  608.               (save-excursion
  609.             (goto-char po-start-of-entry)
  610.             (re-search-forward po-any-msgid-regexp
  611.                        po-end-of-entry t))
  612.               (po-extract-unquoted (current-buffer)
  613.                        (match-beginning 0) (match-end 0)))
  614.           (po-extract-unquoted (current-buffer)
  615.                        po-middle-of-entry po-end-of-entry))))
  616.     (if kill (po-kill-new string))
  617.     string))
  618.  
  619. (defun po-set-field (msgid form)
  620.   "Replace the current msgstr, unless MSGID, using FORM to get a string.
  621. If MSGID is true, replace the current msgid instead.  In either case,
  622. evaluating FORM should insert the wanted string in the current buffer.
  623. If FORM is itself a string, then this string is used for insertion.
  624. The string is properly requoted before the replacement occurs."
  625.   (let ((string (po-eval-requoted form (if msgid "msgid" "msgstr")
  626.                   po-obsolete-flag)))
  627.     (save-excursion
  628.       (goto-char po-start-of-entry)
  629.       (re-search-forward (if msgid po-any-msgid-regexp po-any-msgstr-regexp)
  630.              po-end-of-entry)
  631.       (if (not (string-equal (buffer-substring (match-beginning 0)
  632.                            (match-end 0))
  633.                  string))
  634.       (let ((buffer-read-only nil))
  635.         (replace-match string t t)
  636.         (setq po-offer-validation t)))
  637.       (if msgid
  638.       (progn
  639.         (re-search-forward po-any-msgstr-regexp)
  640.         (setq po-middle-of-entry (match-beginning 0))
  641.         (setq po-end-of-entry (match-end 0)))
  642.     (setq po-end-of-entry (point)))))
  643.   (po-redisplay))
  644.  
  645. (defun po-kill-ring-save-msgstr ()
  646.   "Push the msgstr string from current entry on the kill ring."
  647.   (interactive)
  648.   (po-find-span-of-entry)
  649.   (po-get-field nil t))
  650.  
  651. (defun po-kill-msgstr ()
  652.   "Empty the msgstr string from current entry, pushing it on the kill ring."
  653.   (interactive)
  654.   (po-kill-ring-save-msgstr)
  655.   (po-set-field nil "")
  656.   (po-redisplay))
  657.  
  658. (defun po-yank-msgstr ()
  659.   "Replace the current msgstr string by the top of the kill ring."
  660.   (interactive)
  661.   (po-find-span-of-entry)
  662.   (po-set-field nil (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
  663.   (setq this-command 'yank)
  664.   (po-redisplay))
  665.  
  666. (defun po-msgid-to-msgstr ()
  667.   "Replace the current msgstr with a copy of the msgid string."
  668.   (interactive)
  669.   (po-find-span-of-entry)
  670.   (po-set-field nil (po-get-field t nil))
  671.   (po-redisplay))
  672.  
  673. (defun po-fade-out-entry ()
  674.   "Obsolete an active entry, or completely delete an obsolete entry.
  675. When an entry is completely deleted, its msgstr is put on the kill ring."
  676.   (interactive)
  677.   (po-check-lock)
  678.   (po-find-span-of-entry)
  679.   (if po-obsolete-flag
  680.       (progn
  681.     (po-get-field nil t)
  682.     (let ((buffer-read-only nil))
  683.       (delete-region po-start-of-entry po-end-of-entry))
  684.     (goto-char po-start-of-entry)
  685.     (if (re-search-forward po-any-msgstr-regexp nil t)
  686.         (goto-char (match-beginning 0))
  687.       (re-search-backward po-any-msgstr-regexp nil t))
  688.     (po-current-entry))
  689.     (save-excursion
  690.       (save-restriction
  691.     (narrow-to-region po-start-of-entry po-end-of-entry)
  692.     (let ((buffer-read-only nil))
  693.       (goto-char (point-min))
  694.       (while (not (eobp))
  695.         (or (eq (following-char) ?\n) (insert "# "))
  696.         (search-forward "\n")))))
  697.     (setq po-obsolete-flag t)))
  698.  
  699. ;;; Killing and yanking comments.
  700.  
  701. (defvar po-active-comment-regexp
  702.   "^\\(#\n\\|# .*\n\\)+"
  703.   "Regexp matching the whole editable comment part of an active entry.")
  704.  
  705. (defvar po-obsolete-comment-regexp
  706.   "^\\(# #\n\\|# # .*\n\\)+"
  707.   "Regexp matching the whole editable comment part of an obsolete entry.")
  708.  
  709. (defun po-get-comment (kill-flag)
  710.   "Extract and return the editable comment string, uncommented.
  711. If KILL-FLAG, then add the unquoted comment to the kill ring."
  712.   (po-check-lock)
  713.   (let ((buffer (current-buffer))
  714.     (obsolete po-obsolete-flag))
  715.     (save-excursion
  716.       (goto-char po-start-of-entry)
  717.       (if (re-search-forward (if obsolete po-obsolete-comment-regexp
  718.                      po-active-comment-regexp)
  719.                  po-end-of-entry t)
  720.       (progn
  721.         (set-buffer po-work-buffer)
  722.         (erase-buffer)
  723.         (insert-buffer-substring buffer (match-beginning 0) (match-end 0))
  724.         (goto-char (point-min))
  725.         (while (not (eobp))
  726.           (if (looking-at (if obsolete "# # ?" "# ?"))
  727.           (replace-match "" t t))
  728.           (forward-line 1))
  729.         (and kill-flag (copy-region-as-kill (point-min) (point-max)))
  730.         (buffer-string))
  731.     ""))))
  732.  
  733. (defun po-set-comment (form)
  734.   "Using FORM to get a string, replace the current editable comment.
  735. Evaluating FORM should insert the wanted string in the current buffer.
  736. If FORM is itself a string, then this string is used for insertion.
  737. The string is properly recommented before the replacement occurs."
  738.   (po-check-lock)
  739.   (let ((buffer (current-buffer))
  740.     (obsolete po-obsolete-flag)
  741.     string)
  742.     (save-excursion
  743.       (set-buffer po-work-buffer)
  744.       (erase-buffer)
  745.       (if (stringp form)
  746.       (insert form)
  747.     (push-mark)
  748.     (eval form))
  749.       (if (not (or (bobp) (= (preceding-char) ?\n)))
  750.       (insert "\n"))
  751.       (goto-char (point-min))
  752.       (while (not (eobp))
  753.     (insert (if (= (following-char) ?\n)
  754.             (if obsolete "# #" "#")
  755.           (if obsolete "# # " "# ")))
  756.     (search-forward "\n"))
  757.       (setq string (buffer-string)))
  758.     (goto-char po-start-of-entry)
  759.     (if (and (re-search-forward (if obsolete po-obsolete-comment-regexp
  760.                    po-active-comment-regexp)
  761.                 po-end-of-entry t)
  762.          (not (string-equal
  763.            (buffer-substring (match-beginning 0) (match-end 0))
  764.            string)))
  765.     (let ((buffer-read-only nil))
  766.       (replace-match string t t))
  767.       (skip-chars-forward " \t\n")
  768.       (let ((buffer-read-only nil))
  769.     (insert string))))
  770.   (re-search-forward po-any-msgstr-regexp)
  771.   (setq po-middle-of-entry (match-beginning 0))
  772.   (setq po-end-of-entry (match-end 0))
  773.   (po-redisplay))
  774.  
  775. (defun po-kill-ring-save-comment ()
  776.   "Push the msgstr string from current entry on the kill ring."
  777.   (interactive)
  778.   (po-find-span-of-entry)
  779.   (po-get-comment t))
  780.  
  781. (defun po-kill-comment ()
  782.   "Empty the msgstr string from current entry, pushing it on the kill ring."
  783.   (interactive)
  784.   (po-kill-ring-save-comment)
  785.   (po-set-comment "")
  786.   (po-redisplay))
  787.  
  788. (defun po-yank-comment ()
  789.   "Replace the current comment string by the top of the kill ring."
  790.   (interactive)
  791.   (po-find-span-of-entry)
  792.   (po-set-comment (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
  793.   (setq this-command 'yank)
  794.   (po-redisplay))
  795.  
  796. ;;; Editing translations.
  797.  
  798. (defun po-edit-string (string)
  799.   "Edit STRING recursively in a pop-up buffer, return the edited string.
  800. If recursive edit is aborted, return nil instead."
  801.   (po-check-lock)
  802.   (let ((po-work-buffer-lock t)
  803.     (start po-start-of-entry)
  804.     (middle po-middle-of-entry)
  805.     (end po-end-of-entry)
  806.     (obsolete po-obsolete-flag))
  807.     (prog1
  808.     (save-window-excursion
  809.       (pop-to-buffer po-work-buffer)
  810.       (erase-buffer)
  811.       (insert string "<")
  812.       (goto-char (point-min))
  813.       (condition-case nil
  814.           (progn
  815.         (use-local-map po-edit-mode-map)
  816.         (message "Type `C-c C-c' once done")
  817.         (recursive-edit)
  818.         (goto-char (point-max))
  819.         (skip-chars-backward " \t\n")
  820.         (if (eq (preceding-char) ?<)
  821.             (delete-region (1- (point)) (point-max)))
  822.         (buffer-string))
  823.         (quit nil)))
  824.       (bury-buffer po-work-buffer)
  825.       (setq po-start-of-entry start)
  826.       (setq po-middle-of-entry middle)
  827.       (setq po-end-of-entry end)
  828.       (setq po-obsolete-flag obsolete))))
  829.  
  830. (defun po-edit-comment ()
  831.   "Use another window to edit the current msgstr."
  832.   (interactive)
  833.   (po-find-span-of-entry)
  834. ;  ;; Try showing all of msgid in the upper window while editing.
  835. ;  (goto-char po-start-of-entry)
  836. ;  (re-search-forward po-any-msgid-regexp)
  837. ;  (backward-char 1)
  838. ;  (recenter -1)
  839.   (let ((string (po-edit-string (po-get-comment nil))))
  840.     (and string (po-set-comment string))
  841.     (po-redisplay)))
  842.  
  843. (defun po-edit-msgstr ()
  844.   "Use another window to edit the current msgstr."
  845.   (interactive)
  846.   (po-find-span-of-entry)
  847. ;  ;; Try showing all of msgid in the upper window while editing.
  848. ;  (goto-char po-start-of-entry)
  849. ;  (re-search-forward po-any-msgid-regexp)
  850. ;  (backward-char 1)
  851. ;  (recenter -1)
  852.   (let ((string (po-edit-string (po-get-field nil nil))))
  853.     (and string (po-set-field nil string))
  854.     (po-redisplay)))
  855.  
  856. ;;; String normalization and searching.
  857.  
  858. (defun po-normalize-old-style (explain)
  859.   "Normalize old gettext style fields using K&R C multiline string syntax."
  860.   (let ((here (point-marker))
  861.     (counter 0)
  862.     (buffer-read-only nil))
  863.     (goto-char (point-min))
  864.     (message "Normalizing %d, %s" counter explain)
  865.     (while (re-search-forward
  866.         "\\(^#?[ \t]*msg\\(id\\|str\\)[ \t]*\"\\|[^\" \t][ \t]*\\)\\\\\n"
  867.         nil t)
  868.       (if (= (% counter 10) 0)
  869.       (message "Normalizing %d, %s" counter explain))
  870.       (replace-match "\\1\"\n\"" t nil)
  871.       (setq counter (1+ counter)))
  872.     (goto-char here)
  873.     (message "Normalizing %d...done" counter)))
  874.  
  875. (defun po-normalize-field (msgid explain)
  876.   "Normalize all msgstr's, or msgid's if MSGID."
  877.   (let ((here (point-marker))
  878.     (counter 0))
  879.     (goto-char (point-min))
  880.     (while (re-search-forward po-any-msgstr-regexp nil t)
  881.       (if (= (% counter 10) 0)
  882.       (message "Normalizing %d, %s" counter explain))
  883.       (goto-char (match-beginning 0))
  884.       (po-find-span-of-entry)
  885.       (po-set-field msgid (po-get-field msgid nil))
  886.       (goto-char po-end-of-entry)
  887.       (setq counter (1+ counter)))
  888.     (goto-char here)
  889.     (message "Normalizing %d...done" counter)))
  890.  
  891. (defun po-normalize ()
  892.   "Normalize all entries in the PO file."
  893.   (interactive)
  894.   (po-normalize-old-style "pass 1/3")
  895.   (po-normalize-field t "pass 2/3")
  896.   (po-normalize-field nil "pass 3/3")
  897.   ;; The last PO file entry has just been processed.
  898.   (if (not (= po-end-of-entry (point-max)))
  899.       (let ((buffer-read-only nil))
  900.     (kill-region po-end-of-entry (point-max)))))
  901.  
  902. ;;; Original C sources as context.
  903.  
  904. (defun po-show-path ()
  905.   "Echo the current source search path in the message area."
  906.   (let ((path po-search-path)
  907.     (string "Path is:"))
  908.     (while path
  909.       (setq string (concat string " " (car (car path))))
  910.       (setq path (cdr path)))
  911.     (message string)))
  912.  
  913. (defun po-add-path (directory)
  914.   "Add a given DIRECTORY, requested interactively, to the source search path."
  915.   (interactive "DDirectory for search path: ")
  916.   (setq po-search-path (cons (list directory) po-search-path))
  917.   (setq po-reference-check 0)
  918.   (po-show-path))
  919.  
  920. (defun po-delete-path ()
  921.   "Delete a directory, selected with completion, from the source search path."
  922.   (interactive)
  923.   (setq po-search-path
  924.     (delete (list (completing-read "Directory to remove? "
  925.                        po-search-path nil t))
  926.         po-search-path))
  927.   (setq po-reference-check 0)
  928.   (po-show-path))
  929.  
  930. (defun po-ensure-references ()
  931.   "Extract all references into a list, with paths resolved, if necessary."
  932.   (po-find-span-of-entry)
  933.   (if (= po-start-of-entry po-reference-check)
  934.       ()
  935.     (setq po-reference-alist nil)
  936.     (save-excursion
  937.       (goto-char po-start-of-entry)
  938.       (if (re-search-forward "^#:" po-end-of-entry t)
  939.       (while (looking-at "\\(\n#:\\)? *\\([^: ]+\\):\\([0-9]+\\)")
  940.         (goto-char (match-end 0))
  941.         (let* ((name (buffer-substring (match-beginning 2) (match-end 2)))
  942.            (line (buffer-substring (match-beginning 3) (match-end 3)))
  943.            (path po-search-path)
  944.            file)
  945.           (while (and (progn (setq file (concat (car (car path)) name))
  946.                  (not (file-exists-p file)))
  947.               path)
  948.         (setq path (cdr path)))
  949.           (if path
  950.           (setq po-reference-alist
  951.             (cons (list (concat file ":" line)
  952.                     file
  953.                     (string-to-int line))
  954.                   po-reference-alist)))))))
  955.     (setq po-reference-alist (nreverse po-reference-alist))
  956.     (setq po-reference-cursor po-reference-alist)
  957.     (setq po-reference-check po-start-of-entry)))
  958.  
  959. (defun po-show-source-context (triplet)
  960.   "Show the source context given a TRIPLET which is (PROMPT FILE LINE)."
  961.   (find-file-other-window (car (cdr triplet)))
  962.   (goto-line (car (cdr (cdr triplet))))
  963.   (other-window 1)
  964.   ;; FIXME: Say position in cycle.  But see po-select-reference first.
  965.   (message "Displaying %s" (car triplet)))
  966.  
  967. (defun po-cycle-reference ()
  968.   "Display some source context for the current entry.
  969. If the command is repeated many times in a row, cycle through contexts."
  970.   (interactive)
  971.   (po-ensure-references)
  972.   (if po-reference-cursor
  973.       (progn
  974.     (if (eq last-command 'po-cycle-reference)
  975.         (progn
  976.           (setq po-reference-cursor (cdr po-reference-cursor))
  977.           (or po-reference-cursor
  978.           (setq po-reference-cursor po-reference-alist))))
  979.     (po-show-source-context (car po-reference-cursor)))
  980.     (error "No resolved source references")))
  981.  
  982. (defun po-select-reference ()
  983.   "Select one of the available source contexts for the current entry."
  984.   (interactive)
  985.   (po-ensure-references)
  986.   (if po-reference-alist
  987.       ;; FIXME: Instead, reset reference cursor, then use po-cycle-reference.
  988.       (po-show-source-context
  989.        (assoc
  990.     (completing-read "Which source context? " po-reference-alist nil t)
  991.     po-reference-alist))
  992.     (error "No resolved source references")))
  993.  
  994. ;;; C sources strings though tags table.
  995.  
  996. (defun po-tags-search (restart)
  997.   (interactive "P")
  998.   "Find an unmarked translatable string through all files in tags table.
  999. Disregard some simple strings which are most probably non-translatable.
  1000. With prefix argument, restart search at first file."
  1001.  
  1002.   ;; Take care of restarting the search if necessary.
  1003.   (if restart (setq po-next-file-list nil))
  1004.  
  1005.   ;; Loop doing things until an interesting string is found.
  1006.   (let ((keywords po-keywords)
  1007.     found buffer start end)
  1008.     (while (not found)
  1009.  
  1010.       ;; Reinitialize the source file list if necessary.
  1011.       (if (not po-next-file-list)
  1012.       (progn
  1013.         (setq po-next-file-list
  1014.           (save-excursion
  1015.             (require 'etags)
  1016.             (next-file t)
  1017.             (or next-file-list (error "No files to process"))))
  1018.         (setq po-string-end nil)))
  1019.  
  1020.       ;; Try finding a string after resuming the search position.
  1021.       (message "Scanning %s..." (car po-next-file-list))
  1022.       (save-excursion
  1023.     (setq end po-string-end)
  1024.     (setq buffer (find-file-noselect (car po-next-file-list)))
  1025.     (set-buffer buffer)
  1026.     (or end (setq end (point-min)))
  1027.     (goto-char end)
  1028.     (setq start nil)
  1029.     (while (and (not start)
  1030.             (re-search-forward "\\([\"']\\|/\\*\\)" nil t))
  1031.  
  1032.       (cond ((= (preceding-char) ?*)
  1033.          ;; Disregard comments.
  1034.          (progn (search-forward "*/")
  1035.             (setq end (point))))
  1036.  
  1037.         ((= (preceding-char) ?\')
  1038.          ;; Disregard character constants.
  1039.          (progn (forward-char (if (= (following-char) ?\\) 3 2))
  1040.             (setq end (point))))
  1041.  
  1042.         ((save-excursion
  1043.            (beginning-of-line)
  1044.            (looking-at "^# *\\(include\\|line\\)"))
  1045.          ;; Disregard lines being #include or #line directives.
  1046.          (progn (end-of-line)
  1047.             (setq end (point))))
  1048.  
  1049.         ;; Else, find the end of the string.
  1050.         (t (setq start (1- (point)))
  1051.            (while (not (= (following-char) ?\"))
  1052.              (skip-chars-forward "^\"\\\\")
  1053.              (if (= (following-char) ?\\) (forward-char 2)))
  1054.            (forward-char 1)
  1055.            (setq end (point))
  1056.  
  1057.            ;; Check before string for keyword and opening parenthesis.
  1058.            (if (and
  1059.             (progn (goto-char start)
  1060.                    (skip-chars-backward " \n\t")
  1061.                    (= (preceding-char) ?\())
  1062.             (let (end-keyword)
  1063.               (backward-char 1)
  1064.               (skip-chars-backward " \n\t")
  1065.               (setq end-keyword (point))
  1066.               (skip-chars-backward "A-Za-z0-9_")
  1067.               (member (list (buffer-substring (point) end-keyword))
  1068.                   keywords)))
  1069.                ;; Disregard already marked strings.
  1070.                (setq start nil))
  1071.  
  1072.            (goto-char end)))))
  1073.  
  1074.       (setq po-string-end end)
  1075.  
  1076.       ;; Advance to next file if no string was found.
  1077.       (if (not start)
  1078.       (progn
  1079.         (setq po-next-file-list (cdr po-next-file-list))
  1080.         (if (not po-next-file-list) (error "All files processed"))
  1081.         (setq po-string-end nil))
  1082.  
  1083.     ;; Push the string just found string into the work buffer for study.
  1084.     (po-extract-unquoted buffer start end)
  1085.     (save-excursion
  1086.       (set-buffer po-work-buffer)
  1087.       (goto-char (point-min))
  1088.  
  1089.       ;; Do not disregard if at least three letters in a row.
  1090.       (if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t)
  1091.           (setq found t)
  1092.  
  1093.         ;; Disregard if two letters, and more punctuations than letters.
  1094.         (if (re-search-forward "[A-Za-z][A-Za-z]" nil t)
  1095.         (let ((total (buffer-size)))
  1096.           (goto-char (point-min))
  1097.           (while (re-search-forward "[A-Za-z]+" nil t)
  1098.             (replace-match "" t t))
  1099.           (if (< (* 2 (buffer-size)) total)
  1100.               (setq found t))))
  1101.  
  1102.         ;; Disregard if single letters or no letters at all.
  1103.         ))))
  1104.  
  1105.     ;; Ensure the string is being displayed.
  1106.  
  1107.     (if (one-window-p t) (split-window) (other-window 1))
  1108.     (switch-to-buffer buffer)
  1109.     (goto-char start)
  1110.     (recenter 1)
  1111.     (if (pos-visible-in-window-p end)
  1112.     (goto-char end)
  1113.       (goto-char end)
  1114.       (recenter -1))
  1115.     (other-window 1)
  1116.  
  1117.     ;; Save the string for later commands.
  1118.     (message "Scanning %s...done" (car po-next-file-list))
  1119.     (setq po-string-start start)
  1120.     (setq po-string-end end)))
  1121.  
  1122. (defun po-mark-found-string (keyword)
  1123.   "Mark last found string in C sources as translatable, using KEYWORD."
  1124.   (let ((buffer (find-file-noselect (car po-next-file-list)))
  1125.     (start po-string-start)
  1126.     (end po-string-end)
  1127.     line string)
  1128.  
  1129.     ;; Mark string in C sources.
  1130.     (setq string (po-extract-unquoted buffer start end))
  1131.     (save-excursion
  1132.       (set-buffer buffer)
  1133.       (setq line (count-lines (point-min) start))
  1134.       (goto-char end)
  1135.       (insert ")")
  1136.       (goto-char start)
  1137.       (insert keyword)
  1138.       (if (not (string-equal keyword "_"))
  1139.       (progn (insert " ") (setq end (1+ end))))
  1140.       (insert "("))
  1141.       (setq end (+ end 2 (length keyword)))
  1142.     (setq po-string-end end)
  1143.  
  1144.     ;; Add PO file entry.
  1145.     (let ((buffer-read-only nil))
  1146.       (goto-char (point-max))
  1147.       (insert "\n"
  1148.           (format "#: %s:%d\n" (car po-next-file-list) line)
  1149.           (po-eval-requoted string "msgid" nil)
  1150.           "msgstr \"\"\n")
  1151.       (previous-line 1)
  1152.       (setq po-offer-validation t))))
  1153.  
  1154. (defun po-mark-translatable ()
  1155.   (interactive)
  1156.   "Mark last found string in C sources as translatable, using _()."
  1157.   (if (and po-string-start po-string-end)
  1158.       (progn
  1159.     (po-mark-found-string "_")
  1160.     (setq po-string-start nil))
  1161.     (error "No such string")))
  1162.  
  1163. (defun po-select-mark-and-mark (arg)
  1164.   (interactive "P")
  1165.   "Mark last found string in C sources as translatable, ask for keywoard,
  1166. using completion.  With prefix argument, just ask the name of a preferred
  1167. keyword for subsequent commands, also added to possible completions."
  1168.   (if arg
  1169.       (let ((keyword (list (read-from-minibuffer "Keyword: "))))
  1170.     (setq po-keywords (cons keyword (delete keyword po-keywords))))
  1171.     (if (and po-string-start po-string-end)
  1172.     (let* ((default (car (car po-keywords)))
  1173.            (keyword (completing-read (format "Mark with keywoard? [%s] "
  1174.                          default)
  1175.                      po-keywords nil t )))
  1176.       (if (string-equal keyword "") (setq keyword default))
  1177.       (po-mark-found-string keyword)
  1178.       (setq po-string-start nil))
  1179.       (error "No such string"))))
  1180.  
  1181. ;;; Miscellaneous features.
  1182.  
  1183. (defun po-help ()
  1184.   "Provide an help window for PO mode."
  1185.   (interactive)
  1186.   (po-check-lock)
  1187.   (save-window-excursion
  1188.     (switch-to-buffer po-work-buffer)
  1189.     (erase-buffer)
  1190.     (insert po-help-display-string)
  1191.     (delete-other-windows)
  1192.     (goto-char (point-min))
  1193.     (message "Type any character to continue")
  1194.     (read-char))
  1195.   (bury-buffer po-work-buffer))
  1196.  
  1197. (defun po-undo ()
  1198.   "Undo the last change to the PO file."
  1199.   (interactive)
  1200.   (let ((buffer-read-only nil))
  1201.     (undo)
  1202.     (setq po-offer-validation t)))
  1203.  
  1204. (defun po-statistics ()
  1205.   "Say how many entries in each category, and the current position."
  1206.   (interactive)
  1207.   (po-find-span-of-entry)
  1208.   (let ((current 0) (total 0) (untranslated 0) (obsolete 0) here)
  1209.     (save-excursion
  1210.       (goto-char (point-min))
  1211.       (while (re-search-forward po-any-msgstr-regexp nil t)
  1212.     (if (= (% total 20) 0)
  1213.         (message "Position %d/%d" current total))
  1214.     (setq here (point))
  1215.     (goto-char (match-beginning 0))
  1216.     (setq total (1+ total))
  1217.     (if (eq (point) po-middle-of-entry)
  1218.         (setq current total))
  1219.     (if (eq (following-char) ?#)
  1220.         (setq obsolete (1+ obsolete))
  1221.       (if (looking-at po-empty-msgstr-regexp)
  1222.           (setq untranslated (1+ untranslated))))
  1223.     (goto-char here)))
  1224.     (message "Position %d/%d, with %d untranslated, %d obsolete"
  1225.          current total untranslated obsolete)))
  1226.  
  1227. (defun po-validate ()
  1228.   "Use `msgfmt' for validating the current PO file contents."
  1229.   (interactive)
  1230.   (setq po-offer-validation nil)
  1231.   ;; The following `let' is to protect the previous value of compile-command.
  1232.   (let ((compile-command (concat po-msgfmt-program " -o /dev/null "
  1233.                  buffer-file-name)))
  1234.     (compile compile-command)))
  1235.  
  1236. (defun po-quit ()
  1237.   "Save the PO file and kill buffer.  However, offer validation if
  1238. appropriate and ask confirmation if untranslated strings remain."
  1239.   (interactive)
  1240.   (let ((quit t))
  1241.  
  1242.     ;; Offer validation of newly modified entries.
  1243.     (if (and po-offer-validation
  1244.          (not (y-or-n-p "\
  1245. Some entries were newly modified... Skip validation step? ")))
  1246.     (progn
  1247.       (message "")
  1248.       (setq quit nil)
  1249.       (po-validate)))
  1250.  
  1251.     ;; Offer to work on untranslate entries.
  1252.     (if (and quit
  1253.          (save-excursion
  1254.            (goto-char (point-min))
  1255.            (re-search-forward po-empty-msgstr-regexp nil t))
  1256.          (not (y-or-n-p "\
  1257. Some untranslated entries remain... Quit anyway? ")))
  1258.     (progn
  1259.       (setq quit nil)
  1260.       (po-next-untranslated-entry)))
  1261.  
  1262.     ;; Clear message area
  1263.     (message nil)
  1264.  
  1265.     ;; Or else, kill buffer and quit for true.
  1266.     (if quit
  1267.     (progn
  1268.       (save-buffer)
  1269.       (kill-buffer po-work-buffer)
  1270.       (kill-buffer (current-buffer))))))
  1271.  
  1272. ;;; po-mode.el ends here
  1273.